Option Explicit
Sub F_Sample009()
    'Microsoft Scripting Runtime ѷӳ]w
    'Microsoft VBScript Regular Expressions 5.5 ѷӳ]w
    'rƬOHF-011ޥ{Xһs@XӪ
    Dim myFSO       As Scripting.FileSystemObject
    Dim myTst       As Scripting.TextStream
    Dim myRegEx     As VBScript_RegExp_55.RegExp
    Dim myMchs      As VBScript_RegExp_55.MatchCollection
    Dim myTmpAr     As Variant
    Dim myOutAr()   As String
    Dim myRcnt      As Long
    Dim myMcnt      As Long
    Dim mySplitLoc1 As Long
    Dim mySplitLoc2 As Long
    Dim i           As Long
    Dim j           As Long
    Dim k           As Long
    'ɮתŪJ
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    'wŪJɮ
    Set myTst = myFSO.OpenTextFile(ThisWorkbook.Path & "\" & "F_Book2.csv", 1)
    myTmpAr = Split(myTst.ReadAll, vbCrLf)
    myTst.Close
    Set myTst = Nothing                                         '
    Set myFSO = Nothing
    'HrӰϤ
    Set myRegEx = New VBScript_RegExp_55.RegExp
    With myRegEx
        .IgnoreCase = True
        .Global = True
        .Pattern = ",?[^,]*,"
    End With
    myRcnt = UBound(myTmpAr)
    ReDim myOutAr(1 To myRcnt + 1, 1 To 1)
    j = 0
    '@Ӫ
    k = 256
    mySplitLoc1 = 1
    Set myMchs = myRegEx.Execute(myTmpAr(0))
    myMcnt = myMchs.Count
    Do
        j = j + 1
        If myMcnt > j * k Then
            For i = 0 To myRcnt - 1
                Set myMchs = myRegEx.Execute(myTmpAr(i))
                mySplitLoc1 = myMchs.Item((j - 1) * k).FirstIndex + 1
                mySplitLoc2 = myMchs.Item(j * k).FirstIndex
                myOutAr(i + 1, 1) = _
                Mid(myTmpAr(i), mySplitLoc1, mySplitLoc2 - mySplitLoc1)
            Next
        Else
            For i = 0 To myRcnt - 1
                Set myMchs = myRegEx.Execute(myTmpAr(i))
                mySplitLoc1 = myMchs.Item((j - 1) * k).FirstIndex + 1
                myOutAr(i + 1, 1) = Mid(myTmpAr(i), mySplitLoc1)
            Next
        End If
        Worksheets.Add                                                  'u@sW
        With Range(Cells(1, 1), Cells(myRcnt, 1))
            For i = 1 To myRcnt
                .Cells(i).Value = myOutAr(i, 1)
            Next
            .TextToColumns _
            Destination:=Range("A1"), _
            DataType:=xlDelimited, _
            Comma:=True
        End With
    Loop Until myMcnt < j * k
End Sub
